home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Monster Media 1996 #14
/
Monster Media No. 14 (April 1996) (Monster Media, Inc.).ISO
/
prog_d
/
isamexpt.zip
/
ISAMTABL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-01-13
|
62KB
|
2,045 lines
unit Isamtabl;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, DsgnIntf,
UUseIsam, Filer, LowBrows,
Restruct, ReIndex, ExtCtrls;
type
TIsamTable = class(TComponent)
private
FActive : Boolean;
FAnsiConvert : Boolean;
FTableName : TFileName;
FUnitName : TFileName;
FIsamKey : TStringList;
FRecordName : String;
FRecord : TStringList;
FIID : TStringList;
FNetz : NetSupportType;
FSaveModus : Boolean;
FSourceCreate: Boolean;
FBrowserName : String;
FHeaderName : String;
Procedure MySave;
Function Check(Name : String; SS : TStringList) : Boolean;
procedure CheckInactive;
function GetActive: Boolean;
procedure SetActive(Value: Boolean);
procedure SetTableName(const Value: TFileName);
procedure SetRecordName(const Value: String);
Procedure SetUnitName(const Value: TFileName);
{$IFDEF CodeGen}
Procedure Uses_Einfuegen(var SourceStrings: TStringList);
Procedure Record_Einfuegen(var SourceStrings: TStringList);
Procedure Data_Einfuegen(var SourceStrings: TStringList);
Procedure Key_Deklaration_Einfuegen(var SourceStrings: TStringList);
Procedure Key_Proc_Einfuegen(var SourceStrings: TStringList);
Procedure FormCreate_Einfuegen(var SourceStrings: TStringList);
Procedure FormCreate_Fuellen(var SourceStrings: TStringList);
Procedure FormResize_Fuellen(var SourceStrings: TStringList);
Procedure FormShow_Fuellen(var SourceStrings: TStringList);
Procedure HeaderCreate_Einfuegen(var SourceStrings: TStringList);
Procedure Browser_BuildRow_Einfuegen(var SourceStrings: TStringList);
Procedure Browser_Edit_Einfuegen(var SourceStrings: TStringList);
Procedure Klammern_Loeschen(var SourceStrings: TStringList);
{$ENDIF}
Procedure SetHeaderName(const Value: String);
Procedure SetBrowserName(const Value: String);
{$IFDEF CodeGen}
Procedure SetSourceCreate(const Value: Boolean);
{$ENDIF}
Function GetFormName(SList: TStringList): String;
protected
Procedure SetRecord(Value: TStringList);
Procedure SetKeyProc(Value: TStringList);
Procedure SetIIDProc(Value: TStringList);
Procedure SetNetz(Value: NetSupportType);
{$IFDEF CodeGen}
Procedure BrowRow(Var SListe: TStringList;Var II : Integer);
Procedure GetFeldProc_Einfuegen(var SourceStrings : TStringList);
{$ENDIF}
Procedure SetAnsiConvert(Const Value: Boolean);
public
IFBPtr : IsamFileBlockPtr;
Key_Proc : KeyProc;
RecSize : Longint;
KeyNo : Integer;
Ref : Longint;
Key : IsamKeyStr;
MaxKeys : Byte;
IID : IsamIndDescr;
EditFormIdent: String;
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Open;
Procedure Close;
Procedure ClearFields(var DATA,DUP);
Procedure Delete(var DATA,DUP);
Procedure Insert(var DATA,DUP);
Procedure Append(var DATA,DUP);
Procedure UpdateRecord(var DATA, DUP);
Procedure Get(var DATA, DUP);
Procedure Next(var DATA,DUP);
Function FindKey(Var Data,Dup;var Key1 : IsamKeyStr) : Boolean;
Function FindNearest(Var Data,Dup; Key1 : IsamKeyStr) : Boolean;
Procedure Prior(var DATA,DUP);
Procedure First(var DATA,DUP);
Procedure Last(var DATA,DUP);
Procedure CreateTable;
Function Rebuild: LongInt;
Function RecordCount: Longint;
published
property Active: Boolean read GetActive write SetActive default False;
Property AnsiConvert: Boolean read FAnsiConvert write SetAnsiConvert default True;
Property BrowserName: String read FBrowserName write SetBrowserName;
Property HeaderName: String read FHeaderName write SetHeaderName;
Property MyUnitName : TFileName read FUnitName write SetUnitName;
property TableName: TFileName read FTableName write SetTableName;
property RecordName: String read FRecordName write SetRecordName;
property IsamKeyProc: TStringList read FIsamKey write SetKeyProc;
property IsamRecord: TStringList read FRecord write SetRecord;
property Netz: NetSupportType read FNetz write SetNetz default NoNet;
property SaveModus: Boolean read FSaveModus write FSaveModus default False;
{$IFDEF CodeGen}
property SourceCreate: Boolean read FSourceCreate write SetSourceCreate default False;
{property SourceEditorCreate: Boolean read FEditorCreate write SetEditorCreate default False;}
{$ENDIF}
property AnzahlKeys: Byte read MaxKeys write MaxKeys default 1;
property IIDProc : TStringList read FIID write SetIIDProc;
end;
procedure Register;
implementation
Uses UToolDll, ExptIntf,
FvcBrows, IsamBrow, Proxies,
IsamEdit;
type
TIsamProperty = class(TStringProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValueList(List: TStrings); virtual; abstract;
procedure GetValues(Proc: TGetStrProc); override;
end;
var FHandle: Longint;
function TIsamProperty.GetAttributes: TPropertyAttributes;
begin
Result := [paValueList, paSortList, paMultiSelect, paReadOnly];
end;
procedure TIsamProperty.GetValues(Proc: TGetStrProc);
var
I: Integer;
Values: TStringList;
begin
Values := TStringList.Create;
try
GetValueList(Values);
for I := 0 to Values.Count - 1 do Proc(Values[I]);
finally
Values.Free;
end;
end;
Type
TIsamBrowserProperty = class(TIsamProperty)
procedure GetValueList(List: TStrings); override;
end;
procedure TIsamBrowserProperty.GetValueList(List: TStrings);
var I: Integer;
Component: TComponent;
begin
i:= 0;
While I < Designer.Form.ComponentCount do begin
Component := Designer.Form.Components[I];
if (Component is TIsamBrowser)
and (Component.Name <> '') then List.Add(Component.Name);
Inc(i);
end;
end;
Type
TIsamHeaderProperty = class(TIsamProperty)
procedure GetValueList(List: TStrings); override;
end;
procedure TIsamHeaderProperty.GetValueList(List: TStrings);
var I: Integer;
Component: TComponent;
begin
i:= 0;
While I < Designer.Form.ComponentCount do begin
Component := Designer.Form.Components[I];
if (Component is THeader) and (Component.Name <> '') then List.Add(Component.Name);
Inc(i);
end;
end;
constructor TIsamTable.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FAnsiConvert:= True;
IFBPTR:= NIL;
RecSize:= 0;
KeyNo:= 1;
Ref:= 0;
Key_Proc:= NIL;
FTableName:= '';
FRecordName:= '';
MaxKeys := 1;
FIsamKey:= TStringList.Create;
FRecord:= Tstringlist.create;
FIID := TStringList.Create;
{$Ifdef Test}
FIsamKey.Add('Function '+FRecordName+'KeyProc(Var Daten; KeyNr:Word): IsamKeyStr;');
FIsamKey.Add('var s : String;');
FIsamKey.Add('begin');
FIsamKey.Add(' s:= '+Chr(39)+Chr(39)+';');
FIsamKey.Add(' with '+FRecordName+'(Daten) do begin');
FIsamKey.Add(' case KeyNr of');
FIsamKey.Add(' 1 : S:= '+Chr(39)+Chr(39)+';');
FIsamKey.Add(' End;');
FIsamkey.Add(' end;');
FIsamKey.Add(' KeyProc:= s;');
FIsamkey.Add('end;');
FIsamkey.Add('');
FRecord.Add('Type');
FRecord.Add(FRecordName+' = Record');
FRecord.add(' Dummy : Longint;');
FRecord.add('end;');
{$Endif}
if (csDesigning in ComponentState) then
if Toolservices <> NIL then
begin
FIsamKey.Add('Function '+FRecordName+'KeyProc(Var Daten; KeyNr:Word): IsamKeyStr;');
FIsamKey.Add('var s : String;');
FIsamKey.Add('begin');
FIsamKey.Add(' s:= '+Chr(39)+Chr(39)+';');
FIsamKey.Add(' with '+FRecordName+'(Daten) do begin');
FIsamKey.Add(' case KeyNr of');
FIsamKey.Add(' 1 : S:= '+Chr(39)+Chr(39)+';');
FIsamKey.Add(' End;');
FIsamkey.Add(' end;');
FIsamKey.Add(' KeyProc:= s;');
FIsamkey.Add('end;');
FIsamkey.Add('');
FRecord.Add('Type');
FRecord.Add(FRecordName+' = Record');
FRecord.add(' Dummy : Longint;');
FRecord.add('end;');
end;
if (csDesigning in ComponentState) then
if Toolservices <> NIL then
begin
if FUnitName = '' then
begin
{if not ToolServices.SaveProject then ErrorWindow('Project konnte nicht',
'gespeichert werden'); }
FUnitName := ToolServices.GetUnitName(ToolServices.GetUnitCount);
end;
end;
if (csdesigning in componentstate) then begin
GetFHandle(FHandle);
end;
EditFormIdent:= '';
end;
destructor TIsamTable.Destroy;
begin
CheckInactive;
FIsamKey.Free;
FRecord.Free;
FIID.Free;
inherited Destroy;
end;
procedure Register;
begin
RegisterComponents('B-Tree Filer', [TIsamTable]);
RegisterPropertyEditor(TypeInfo(String), TIsamTable, 'BrowserName', TIsamBrowserProperty);
RegisterPropertyEditor(TypeInfo(String), TIsamTable, 'HeaderName', TIsamHeaderProperty);
end;
Function TIsamTable.GetFormName(SList: TStringList): String;
var S: Integer;
SStr: String;
Gefunden: Boolean;
begin
S:= 0;
SStr:= '';
Gefunden:= False;
While (S < SList.Count) and (Gefunden = False) do begin
SStr:= UpperCase(SList[S]);
Strip(SStr);
if Pos('=CLASS',SStr) > 0 then Gefunden:= True
else Inc(S);
end;
If Gefunden then begin
SStr:= Copy(SStr,1,Pos('=CLASS',SStr)-1);
end
else SStr:= '';
Result:= SStr;
end;
{$IFDEF CodeGen}
Procedure GetArray(AStr: String; var Arr1,Arr2: Integer);
var A1Str: String;
A1,A2,Code: Integer;
begin
Arr1:= 1;
Arr2:= 1;
if (Pos('ARRAY[',AStr) > 0) and (Pos('CHAR',Astr) = 0) then begin
Delete(AStr,1,Pos('ARRAY[',AStr)+5);
if Pos(']',AStr) > 0 then begin
AStr:= Copy(AStr,1,Pos(']',AStr)-1);
if Pos('.',AStr) > 0 then begin
A1Str:= Copy(AStr,1,Pos('.',AStr)-1);
While (Pos('.',AStr) > 0) do Delete(AStr,1,Pos('.',AStr));
Strip(a1Str); Strip(AStr);
Val(A1Str,A1,Code);
Val(AStr,A2,Code);
if (A1 > 0) and (A2 > 0) then begin
Arr1:= A1;
Arr2:= A2;
if Arr1 > Arr2 then begin
A1:= Arr2;
Arr2:= Arr1;
Arr1:= A1;
end;
end;
end;
end;
end;
end;
Function GetBrowserString(NStr: String; Arr: Integer): String;
var S,FeldName,AStr: String;
begin
S:= '';
FeldName:= Copy(NStr,1,Pos(':',NStr)-1);
Strip(FeldName);
if Arr > 0 then begin
Str(Arr,AStr);
FeldName:= FeldName+'['+AStr+']';
end;
if (Length(FeldName) > 0) and (Pos('DUMMY',NStr) = 0) and (Pos('MEMO',NStr) = 0) then begin
if Pos('WORD',NStr) > 0 then S:= 'DateStr('+FeldName+')'
else if Pos('INTEGER',NStr) > 0 then S:= 'IntStr('+FeldName+')'
else if Pos('BYTE',NStr) > 0 then S:= 'IntStr('+FeldName+')'
else if Pos('LONGINT',NStr) > 0 then S:= 'DateStr('+FeldName+')'
else if Pos('REAL',NStr) > 0 then S:= 'FormDezStr('+FeldName+',10,2)'
else S:= 'String_oem2ansi(Table.AnsiConvert,'+FeldName+')'
end;
GetBrowserString:= S;
end;
Procedure TIsamTable.BrowRow(Var SListe: TStringList; VAR II:Integer);
Var NStr : String;
A,Feld,x,Arr1,Arr2: Integer;
BStr,FeldName: String;
s : String;
begin
S := '';
if IsamRecord.Count > 0 then begin
Feld:= 0;
For x:= 0 to IsamRecord.Count-1 do begin
NStr:= IsamRecord[x];
NStr:= Uppercase(NStr);
Strip(NStr);
if (Pos(':',NStr) > 0) then begin
GetArray(NStr,Arr1,Arr2);
if Arr1 = Arr2 then begin
A:= 0;
BStr:= GetBrowserString(NStr,A);
if BStr <> '' then begin
Inc(Feld);
SListe.Insert(ii,' '+DezStr(Feld)+': s:= '+BStr+'+'+Chr(39)+'^'+Chr(39)+';');
Inc(ii);
end;
end
else begin
For a:= arr1 to Arr2 do begin
BStr:= GetBrowserString(NStr,A);
if BStr <> '' then begin
Inc(Feld);
SListe.Insert(ii,' '+DezStr(Feld)+': s:= '+BStr+'+'+Chr(39)+'^'+Chr(39)+';');
Inc(ii);
end;
end;
end;
end;
end;
end;
end;
{$ENDIF}
Function TIsamTable.Check(Name:String; SS:TStringList) : Boolean;
Var
SStr : String;
i : word;
begin
i := 0;
Name := UpperCase(Name);
Strip(Name);
Check := True;
if SS.Count > 0 then
repeat
SStr:= SS[i];
SStr:= Uppercase(SStr);
Strip(SStr);
if Pos(Name,SStr) > 0 then exit;
inc(i);
Until (i >= SS.Count);
Check := False;
end;
Procedure TIsamTable.MySave;
begin
if ToolServices <> NIL then begin
ToolServices.ReloadFile(FUnitName);
Toolservices.SaveFile(FUnitName);
if not ToolServices.SaveProject then begin
if Sprache = 1 then Errorwindow('Project could not be saved.','')
else ErrorWindow('Project konnte nicht','gespeichert werden.');
end;
end
else Errorwindow('TOOLSERVICES not assigned','');
end;
Procedure TIsamTable.SetAnsiConvert(Const Value: Boolean);
begin
FAnsiConvert:= Value;
end;
Procedure TIsamTable.SetNetz(Value: NetSupportType);
begin
FNetz:= Value;
end;
Procedure TIsamTable.CheckInactive;
begin
Active:= False;
end;
function TIsamTable.GetActive: Boolean;
begin
Result := (FActive = True);
end;
Procedure TIsamTable.SetUnitName (Const Value:TFileName);
begin
FunitName := Value;
if (csDesigning in ComponentState) then
if Toolservices <> NIL then
if Value <> FUnitName then
begin
if Sprache = 1 then begin
if Janein('Unitname changed, reload?','New: '+Value+' FUnitName: '+FUnitName) then
FUnitName := ToolServices.GetUnitName(ToolServices.GetUnitCount);
end
else begin
if Janein('Unitname geΣndert, neu einlesen?','Neu: '+Value+' FUnitName: '+FUnitName) then
FUnitName := ToolServices.GetUnitName(ToolServices.GetUnitCount);
end;
end;
end;
procedure TIsamTable.SetActive(Value: Boolean);
var AllesOk : Boolean;
begin
AllesOk := True;
if FActive <> Value then begin
if Value then begin
if TableName <> '' then begin
if BtFileBlockIsOpen(IFBPtr) then begin
if Sprache = 1 then Errorwindow('Isamtable '+TableName,'is already opened')
else Errorwindow('Die Isamdatei: '+TableName,'ist bereits ge÷ffnet');
FActive := True;
Value := True;
AllesOk := False;
end else
if not Exist(TableName+'.DAT') then begin
if Sprache = 1 then Errorwindow('Isamtable '+TableName+' does not exist in the active path','')
else Errorwindow('Isamtabelle: '+TableName+' existiert nicht im angegebenen Directory !','');
FActive := False;
Value := False;
AllesOk := False;
exit;
end else
begin
FActive := False;
InitIsam(Netz);
if RecSize = 0 then begin
if Sprache = 1 then Errorwindow('Isamtable will be opened local','')
else Errorwindow('Die Isamdatei wird lokal','ge÷ffnet');
BTOpenFileBlock(IFBPtr,TableName,False,False,SaveModus,False);
Diee;
if ISAMOK then FActive:= True else AllesOk := False;
end
else begin
if not(csDesigning in ComponentState) then begin
GetFHandle(FHandle);
end;
DateiOeffnen (IFBPtr,TableName,SaveModus,RecSize);
DIEE;
if ISAMOK then FActive:= True else AllesOk := False;
end;
end;
end
else begin
if Sprache = 1 then Errorwindow('no tablename assigned','')
else Errorwindow('kein Tabellenname angegeben','');
end;
end
else begin
if BtFileBlockIsOpen(IFBPtr) then begin
DateiSchliessen(IFBPtr);
DIEE;
end;
FActive:= False;
ExitIsam;
end;
end;
if not AllesOk then begin
if Sprache = 1 then Errorwindow('SETACTIVE-Error','Last ISAMERROR: '+DezStr(IsamError))
else Errorwindow('In SetActive ist ein Fehler aufgetreten',
'letzter IsamError: '+DezStr(IsamError));
end;
end;
procedure TIsamTable.SetTableName(const Value: TFileName);
var S: String;
begin
CheckInactive;
S:= Value;
if Pos('.',S) > 0 then begin
S:= Copy(S,1,Pos('.',S)-1);
end;
FTableName := S;
end;
procedure TIsamTable.SetRecordName(Const Value: String);
var i: Integer;
Gefunden: Boolean;
SStr: String;
begin
if FRecordName <> Value then begin
FRecordName := Value;
if (csdesigning in componentstate) then begin
{if Owner is TForm then begin
if TForm(Owner).Designer <> NIL then TForm(Owner).Designer.Modified;
end;}
i:= 0;
Gefunden:= False;
While (i < FIsamKey.Count) and (Gefunden = False) do begin
SStr:= UpperCase(FIsamKey[i]);
Strip(SStr);
if (Pos('(DATEN)',SStr) > 0) then Gefunden:= True
else Inc(i);
end;
if Gefunden then begin
FIsamKey[i]:= ' with '+FRecordName+'(Daten) do begin';
end;
i:= 0;
Gefunden:= False;
While (i < FRecord.Count) and (Gefunden = False) do begin
SStr:= UpperCase(FRecord[i]);
Strip(SStr);
if (Pos('=RECORD',SStr) > 0) then Gefunden:= True
else Inc(i);
end;
if Gefunden then begin
FRecord[i]:= FRecordName+' = Record';
end;
end;
end;
end;
Procedure TIsamTable.SetRecord(Value: TStringList);
begin
FRecord.Assign(Value);
end;
Procedure TIsamTable.SetBrowserName(Const Value: String);
begin
if FBrowserName <> Value then
begin
FBrowserName:= Value;
end;
end;
Procedure TIsamTable.SetHeaderName(Const Value: String);
begin
if FHeaderName <> Value then
begin
FHeaderName := Value;
end;
end;
Procedure TIsamTable.SetKeyProc(Value: TStringList);
begin
FIsamKey.Assign(Value);
end;
Procedure TIsamTable.SetIIDProc(Value: TStringList);
begin
FIID.Assign(Value);
end;
{$IFDEF CodeGen}
Procedure TIsamTable.Klammern_Loeschen(Var SourceStrings : TStringList);
Var
I : Integer;
S : STring;
begin
if BrowserName = '' then exit;
if HeaderName = '' then exit;
I := 0;
Repeat
S:= SourceStrings[I];
if Pos('{}',S) > 0 then SourceStrings.Delete(i)
else Inc(I);
Until i >= SourceStrings.Count;
end;
{$ENDIF}
Procedure TIsamTable.Open;
begin
Active:= True;
end;
Procedure TIsamTable.Close;
begin
CheckInactive;
end;
{
FindFirst = 0;
FindLast = 1;
FindNext = 2;
FindPrev = 3;
FindALL = 4;
}
Procedure TIsamTable.First(var DATA, DUP);
begin
if Active then begin
Nachbarkey(IFBPtr,KeyNo,Ref,Key,0);
DIEE;
if ISAMOK then begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
end;
end;
end;
Procedure TIsamTable.CreateTable;
Var Act : Boolean;
Txt1,Txt2: String;
begin
Act := Active;
if Active then Close;
if Sprache = 1 then begin
Txt1:= 'Table '+TableName+' already exists.';
Txt2:= 'overwrite ?';
end
else begin
Txt1:= 'IsamTabelle '+TableName+' existiert schon.';
Txt2:= '▄berschreiben ?';
end;
if exist(TableName+'.Dat') then if not Janein(Txt1,Txt2) then
begin
if Act then Open;
exit;
end;
InitIsam(Netz);
if RecSize = 0 then begin
if Sprache = 1 then Errorwindow('No recordsize assigned','')
else Errorwindow('Recordgr÷▀e ist nicht angegeben','');
end
else begin
BTCREATEFileBlock(TableName,RecSize, MaxKeys, IID);
DIEE;
end;
ExitIsam;
if Act then Open;
end;
{$F+}
Procedure DisplayRebuildInfo ( KeyNr : Integer;
NrRead,
NrWrite : LongInt;
Var DatS;
Len : Word );
Begin
Waitwindow('KeyNr.: '+DezStr(KeyNr),
'NrRead: '+DezStr(NrRead)+' NrWrite: '+DezStr(NrWrite));
End;
{$F-}
Function TIsamTable.Rebuild: LongInt;
Const
MsgFileCreated : Boolean = True;
Var Act: Boolean;
begin
if TableName = '' then begin
if Sprache = 1 then Errorwindow('No tablename assigned','')
else Errorwindow('Tabellenname wurde nicht angegeben','')
end
else begin
Act:= Active;
if Active then Close;
if Sprache = 1 then WaitWindow('Reorg starts','')
else WaitWindow('Reorg beginnt','');
InitIsam(Netz);
IsamReXUserProcPtr := @DisplayRebuildInfo;
ReIndexFileBlock (TableName,
MaxKeys,
IID ,
False,
Key_Proc,
False,
MsgFileCreated,
BTNoCharConvert,
Nil);
ExitIsam;
CloseWait;
if Act then Open;
end;
Rebuild := IsamError;
end;
Procedure TIsamTable.Insert(var DATA, DUP);
begin
if Active then begin
SatzAnlegen (IFBPtr,Data,Key_Proc);
DIEE;
Get(DATA,DUP);
end;
end;
Procedure TIsamTable.Append(var DATA, DUP);
begin
if Active then begin
SatzAnlegen (IFBPtr,Data,Key_Proc);
DIEE;
Get(DATA,DUP);
end;
end;
Procedure TIsamTable.UpdateRecord(var DATA, DUP);
var Ok: Boolean;
begin
if Active then begin
SatzAendern(IFBPtr,Ref,DATA,DUP,Key_Proc,Ok);
DIEE;
Get(DATA,DUP);
end;
end;
Procedure TIsamTable.Get(var DATA, DUP);
begin
if Active then begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
Key:= Key_Proc(DATA,KeyNo);
end;
end;
Procedure TIsamTable.Last(var DATA, DUP);
begin
if Active then begin
Nachbarkey(IFBPtr,KeyNo,Ref,Key,1);
DIEE;
if ISAMOK then begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
end;
end;
end;
Procedure TIsamTable.ClearFields(var DATA, DUP);
begin
if Active then begin
Fillchar(Data,Sizeof(Data),0);
Fillchar(Dup,Sizeof(Dup),0);
end;
end;
Procedure TIsamTable.Delete(var DATA, DUP);
Var ok,
Found : Boolean;
Key1 : ISamKeyStr;
Txt1 : String;
begin
if Active then begin
Key1 := Key_Proc(Data,KeyNo);
KeySuchen (IFBPtr,KeyNo,Ref,Key1,Found);
Diee;
if Found then begin
if Sprache = 1 then Txt1:= 'Delete '+Key1+' ?'
else Txt1:= 'Datensatz '+Key1+' l÷schen ?';
if Janein(Txt1,'') then begin
Satzloeschen(IFBPtr,Ref,Dup,Key_Proc,OK);
DIEE;
end;
end else begin
if Sprache = 1 then Errorwindow('Record not found','')
else Errorwindow('DatenSatz nicht gefunden!','');
end;
end
else Errorwindow('Tabelle ist nicht aktiv','');
end;
Procedure TIsamTable.Next(var DATA, DUP);
begin
if Active then begin
Nachbarkey(IFBPtr,KeyNo,Ref,Key,2);
DIEE;
if ISAMOK then begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
end;
end;
end;
Function TIsamTable.FindKey(Var Data,Dup;var Key1 : IsamKeyStr) : Boolean;
Var Found : Boolean;
begin
Found := False;
if Active then begin
KeySuchen (IFBPtr,KeyNo,Ref,Key1,Found);
Diee;
if Found then
begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
Key1:= Key_Proc(Data,KeyNo);
Key:= Key1;
end;
end;
FindKey := Found;
end;
Function TIsamTable.FindNearest(Var Data,Dup; Key1 : IsamKeyStr) : Boolean;
Var Found : Boolean;
begin
Found := False;
if Active then begin
KeySuchen (IFBPtr,KeyNo,Ref,Key1,Found);
Diee;
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
Found := True;
end;
FindNearest := Found;
end;
Procedure TIsamTable.Prior(var Data,Dup);
begin
if Active then begin
Nachbarkey(IFBPtr,KeyNo,Ref,Key,3);
DIEE;
if ISAMOK then begin
SatzLesen (IFBPtr,Ref,Data,Dup);
DIEE;
end;
end;
end;
Function TIsamTable.RecordCount: Longint;
begin
if IFBPTR <> NIL then Result:= BtUsedRecs(IFBPtr)
else Result:= 0;
end;
{$IFDEF CodeGen}
Procedure TIsamTable.Uses_Einfuegen(var SourceStrings: TStringList);
{ok}
var SrceStr,SStr: String;
Gef1,Gef2,Gef3: Boolean;
S : Integer;
begin
S:= 0;
Gef1:= False;
Gef2:= False;
Gef3:= False;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('USES',SStr) > 0) or (S >= SourceStrings.Count);
if Pos('USES',SStr) > 0 then begin
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if Pos('FILER',SStr) > 0 then Gef1:= True;
if Pos('UUSEISAM',SStr) > 0 then Gef2:= True;
if (Pos('LOWBROWS',SStr) > 0) or (BrowserName = '') then Gef3:= True;
Inc(S);
Until (Pos(';',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
if Gef1 = False then begin
SrceStr:= SourceStrings[S];
System.Delete(SrceStr,Length(SrceStr),1);
SrceStr:= SrceStr + ','+#13+#10+' Filer;';
SourceStrings[S]:= SrceStr;
end;
if Gef2 = False then begin
SrceStr:= SourceStrings[S];
System.Delete(SrceStr,Length(SrceStr),1);
SrceStr:= SrceStr + ', UUseIsam;';
SourceStrings[S]:= SrceStr;
end;
if Gef3 = False then begin
SrceStr:= SourceStrings[S];
System.Delete(SrceStr,Length(SrceStr),1);
SrceStr:= SrceStr + ', LowBrows;';
SourceStrings[S]:= SrceStr;
end;
end;
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('IMPLEMENTATION',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('USES',SStr) > 0) or (Pos('{$R*.DFM}',SStr) > 0) or (S >= SourceStrings.Count);
if Pos('USES',SStr) = 0 then begin
Dec(S);
SrceStr:= 'Uses SysUtils, UToolDll, Isam_Key, IsamSuch;';
SourceStrings.Insert(S,SrceStr);
end
else begin
Gef1:= False;
Dec(S);
if Pos('UTOOLDLL',SStr) > 0 then Gef1:= True;
if Gef1 = False then begin
SrceStr:= SourceStrings[S];
System.Delete(SrceStr,Length(SrceStr),1);
SrceStr:= SrceStr + ', UTOOLDLL;';
SourceStrings[S]:= SrceStr;
end;
end;
end;
Procedure TIsamTable.Record_Einfuegen(var SourceStrings : TStringList);
{ok}
var RStr,RecStr,SStr,SrceStr: String;
S,R : Integer;
RecStrings : TStringList;
begin
S := 0;
R := 0;
if FRecord = Nil then exit;
RecStrings := TStringList.Create;
RecStrings.Assign(FRecord);
R := 0;
if RecStrings.Count > 0 then
begin
Repeat
RStr := RecStrings[R];
RStr := UpperCase(RStr);
if Pos(UpperCase(FRecordName),RStr) = 0 then RecStrings.Delete(R)
else inc(R);
Until (Pos(UpperCase(FRecordName),RStr) > 0) or (R >= RecStrings.Count);
end else
begin
RecStrings.Free;
exit;
end;
R := 0;
if RecStrings.Count > 0 then begin
Repeat
RStr := RecStrings[R];
RStr := UpperCase(RStr);
if Pos(UpperCase(FRecordName),RStr) = 0 then RecStrings.Delete(R) else
inc(R);
Until (Pos(UpperCase(FRecordName),RStr) > 0) or (R >= RecStrings.Count);
end;
Repeat
{Zuersteinmal l÷schen}
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if Pos(Uppercase(FRecordName)+'=RECORD',SStr) > 0 then
begin
if Sprache = 1 then SErrorwindow(FRECORDNAME+' deleted','')
else Serrorwindow(FRECORDNAME+' wird gel÷scht','');
Repeat
SourceStrings.Delete(S);
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Until(Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
if (Pos('END;',SStr) > 0) then SourceStrings.Delete(S);
end;
Inc(S);
Until (Pos('=CLASS',SStr) > 0) or (S >= SourceStrings.Count);
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('=CLASS',SStr) > 0) or (S >= SourceStrings.Count);
if (Pos('=CLASS',SStr) > 0) and (RecStrings.Count > 0) then begin
if Sprache = 1 then SErrorwindow('Create new record ',FRecordName)
else SErrorwindow('Record neu aufbauen',FrecordName);
Dec(S);
Dec(R);
Repeat
RecStr := RecStrings[R];
if Pos('RECORD',UpperCase(RecStr)) = 0 then
RecStr:= Copy(RecStr,1,Pos(';',RecStr));
RecStr := Delspace(RecStr);
RecStr := ' '+RecStr;
RStr:= Uppercase(RecStr);
Strip(RStr);
Inc(R);
if Delspace(RecStr) <> '' then begin
SourceStrings.Insert(S,RecStr);
Inc(S);
end;
Until (Pos('END;',RStr) > 0) or (R >= RecStrings.Count);
end;
RecStrings.Free;
end;
Procedure TIsamTable.Data_Einfuegen(var SourceStrings: TStringList);
{ok}
var SStr,
SrceStr: String;
S : Integer;
begin
S:= 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('PUBLIC',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if (Pos(UpperCase(RECORDNAME+'DATEN'),SStr) > 0) or
(Pos(UpperCase(RECORDNAME+'DUP'),SStr) > 0)
then
begin
SourceStrings.Delete(S);
if Sprache = 1 then SErrorwindow(RECORDNAME+' deleted','')
else Serrorwindow(RECORDNAME+' wird gel÷scht','DAT: und DUP:');
end
else
Inc(S);
Until (Pos('PROCEDURE',SStr) > 0) or
(Pos('PROPERTY',SStr) > 0) or
(Pos('FUNCTION',SStr) > 0) or
(Pos('END;',SStr) > 0) or
(S >= SourceStrings.Count);
Dec(S);
SStr:= ' '+RecordName+'Daten: '+FRecordName+';';
SourceStrings.Insert(S,SStr);
SStr:= ' '+RecordName+'Dup : '+FRecordName+';';
SourceStrings.Insert(S,SStr);
end;
Procedure TIsamTable.Key_Deklaration_Einfuegen(var SourceStrings: TStringList);
{ok}
var KStr,KeyStr,
SStr,SrceStr: String;
KeyStrings : TStringList;
R,S : Integer;
begin
if FIsamKey = Nil then exit;
{Nach Public und darauf folgendem End suchen}
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('PUBLIC',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
{Wenn die Keyproc besteht, dann l÷schen}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if (Pos(UpperCase(RecordName)+'KEYPROC(',SStr) > 0) then
begin
SourceStrings.Delete(S);
if Sprache = 1 then SErrorwindow('Delete KEYPROC-Declaration','')
else SErrorwindow('KeyprocDeklaration wird gel÷scht','');
end else Inc(S);
Until (Pos('IMPLEMENTATION',SStr) > 0) or (S >= SourceStrings.Count);
{Nun wieder von vorne und die KeyProc eintragen}
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('PUBLIC',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
SourceStrings.Insert(S,'Function '+RecordName+'KeyProc(Var Daten; KeyNr:Word): IsamKeyStr; FAR;');
inc(S);
if Sprache = 1 then SErrorwindow('KEYPROC-declaration added','')
else SErrorwindow('KeyprocDeklaration wird hinzugefⁿgt','');
end;
Procedure TIsamTable.GetFeldProc_Einfuegen(var SourceStrings : TStringList);
var KStr,KeyStr,
SStr,SrceStr: String;
KeyStrings : TStringList;
R,S : Integer;
Gefunden : Boolean;
begin
R := 0;
if IsamRecord.Count < 1 then begin
if Sprache = 1 then Errorwindow('no record defined','')
else Errorwindow('Kein Record definiert','');
Exit;
end;
S := 0;
{zuerst wird bis nach Implementation gesucht (*.DFM)}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('{$R*.DFM',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase(RecordName)+'GETFELDPROC(',SStr) > 0) or (S >= SourceStrings.Count);
if (Pos(UpperCase(RecordName)+'GETFELDPROC(',SStr) > 0) then
begin
if Sprache = 1 then SErrorwindow('GetFeldProc will be deleted','')
else SErrorwindow('GetFeldProc wird gel÷scht.','');
Dec(S);
Repeat
SourceStrings.Delete(S);
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Until (Pos('RESULT',SStr) > 0)
or(S >= SourceStrings.Count);
SourceStrings.Delete(S);
SourceStrings.Delete(S); {Das ist das end; der GetFeldProc}
end else
begin
{wenn GetFeldProc nicht gefunden}
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
inc(S);
Until (S >= SourceStrings.Count)
or (Pos(Uppercase('{$R*.DFM'),SStr) > 0);
Dec(s);
SourceStrings.Insert(S,' ');
Inc(S);
end;
R:= 0;
if Sprache = 1 then SErrorwindow('GetFeldProc added','')
else SErrorwindow('GetFeldProc wird eingetragen.','');
SourceStrings.Insert(S,'Function '+RecordName+'GetFeldProc(Feld: Integer; Table: TIsamTable; var DATA): String; far;');
Inc(S);
SourceStrings.Insert(S,'var S: String;');
Inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,' S:= '+Chr(39)+Chr(39)+';');
Inc(S);
SourceStrings.Insert(S,' With '+RECORDName+'(Data) do begin');
Inc(S);
SourceStrings.Insert(S,' Case Feld of');
Inc(S);
BrowRow(SourceStrings,S);
SourceStrings.Insert(S,' end;');
Inc(S);
SourceStrings.Insert(S,' end;');
Inc(S);
SourceStrings.Insert(S,' Result:= S;');
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
end;
Procedure TIsamTable.Key_Proc_Einfuegen(var SourceStrings : TStringList);
{ok noch nicht ganz}
var KStr,KeyStr,
SStr,SrceStr: String;
KeyStrings : TStringList;
R,S : Integer;
Gefunden : Boolean;
begin
R := 0;
S := 0;
if FIsamKey = Nil then exit;
KeyStrings := TStringList.Create;
KeyStrings.Assign(FIsamKey);
if KeyStrings.Count = 0 then exit;
{zuerst wird bis nach Implementation gesucht (*.DFM)}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('{$R*.DFM',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase(RecordName)+'KEYPROC(',SStr) > 0) or (S >= SourceStrings.Count);
if (Pos(UpperCase(RecordName)+'KEYPROC(',SStr) > 0) then
begin
if Sprache = 1 then SErrorwindow('KeyProc will be deleted','')
else SErrorwindow('KeyProc wird gel÷scht.','');
Dec(S);
Repeat
SourceStrings.Delete(S);
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Until (Pos(Uppercase(RecordName+'KEYPROC'),SStr) > 0)
or(S >= SourceStrings.Count);
SourceStrings.Delete(S);
SourceStrings.Delete(S); {Das ist das end; der Keyproc}
end else
begin
{wenn KeyProc nicht gefunden}
S := 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
inc(S);
Until (S >= SourceStrings.Count)
or (Pos(Uppercase('END.'),SStr) > 0);
Dec(s);
Dec(s);
end;
R:= 0;
if Sprache = 1 then SErrorwindow('KeyProc will be added','')
else SErrorwindow('KeyProc wird eingetragen.','');
Repeat
KeyStr:= KeyStrings[R];
KStr:= Uppercase(KeyStr);
if Pos('FUNCTION ',KStr) > 0 then begin
SStr:= KStr;
System.Delete(SStr,Pos('FUNCTION ',SStr),9);
if Pos('KEYPROC',SStr) > 0 then System.Delete(SStr,1,Pos('KEYPROC',SStr)-1);
KeyStr:= 'Function '+RecordName+SStr;
end;
if Pos('(DATEN)',KStr) > 0 then begin
SStr:= KStr;
System.Delete(SStr,1,Pos('(DATEN)',SStr)-1);
KeyStr:= ' With '+FRecordName+'(Daten) do begin';
end;
if Pos('KEYPROC:=',KStr) > 0 then begin
SStr:= KStr;
System.Delete(SStr,1,Pos('KEYPROC:=',SStr)-1);
KeyStr:= ' '+RecordName+SStr;
end;
SourceStrings.Insert(S,KeyStr);
Inc(S);
Inc(R);
Until R >= KeyStrings.Count;
end;
Procedure TIsamTable.FormCreate_Einfuegen(var SourceStrings: TStringList);
{ok}
var SrceStr,SStr: String;
Gefunden1,
Gefunden2,
Gefunden3 : Boolean;
i : Byte;
S : Integer;
FormName : String;
begin
Gefunden1 := Check('Procedure FormCreate(Sender',SourceStrings) ;
Gefunden2 := Check('Procedure FormResize(Sender',SourceStrings) ;
Gefunden3 := Check('Procedure FormShow(Sender',SourceStrings) ;
FormName:= GetFormName(SourceStrings);
S:= 0;
Gefunden1 := False;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if Pos('FORMCREATE',SStr) > 0 then Gefunden1:= True;
Inc(S);
Until (Pos('PRIVATE',SStr) > 0) or (S >= SourceStrings.Count);
if S < SourceStrings.Count then begin
if Gefunden1 = False then begin
Dec(S);
SourceStrings.Insert(S,' Procedure FormCreate(Sender: TObject);');
Inc(S);
end;
If Gefunden2 = False then begin
if BrowserName <> '' then begin
SourceStrings.Insert(S,' Procedure FormResize(Sender: TObject);');
Inc(S);
end;
end;
if Gefunden3 = False then begin
if BrowserName <> '' then begin
SourceStrings.Insert(S,' Procedure FormShow(Sender: TObject);');
Inc(S);
end;
end;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('{$R*.DFM',SStr) > 0) or (S >= SourceStrings.Count);
end;
if S < SourceStrings.Count then begin
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('FORMCREATE',SStr) > 0) or (S >= SourceStrings.Count);
end;
{Nun wird Formcreate eingetragen}
if Pos('FORMCREATE',SStr) = 0 then
begin
Dec(S);
SourceStrings.Insert(S,'Procedure '+FormName+'.FormCreate(Sender: TObject);');
Inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,'{}'); {Damit Delphi mir das nicht wieder l÷scht}
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
SourceStrings.Insert(S,'');
Inc(S);
if Gefunden2 = False then begin
if BrowserName <> '' then begin
SourceStrings.Insert(S,'Procedure '+FormName+'.FormResize(Sender: TObject);');
inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,'{}'); {Damit Delphi mir das nicht wieder l÷scht}
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
SourceStrings.Insert(S,'');
Inc(S);
end;
end;
If gefunden3 = False then begin
if BrowserName <> '' then begin
SourceStrings.Insert(S,'Procedure '+FormName+'.FormShow(Sender: TObject);');
inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,'{}'); {Damit Delphi mir das nicht wieder l÷scht}
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
SourceStrings.Insert(S,'');
Inc(S);
end;
end;
if Sprache = 1 then SErrorwindow('Procedures Formcreate, FormShow, FormResize','added')
else SErrorwindow('Proceduren Formcreate,FormShow,FormResize ','werden eingetragen.');
end;
end;
Procedure TIsamTable.Formcreate_Fuellen(var SourceStrings: TStringList);
{ok}
Var
S,R : Integer;
SrceStr, SStr,
FormName : String;
IIDStr : String;
IIDStrings : TStringList;
Gefunden1,
Gefunden2,
Gefunden3,
Gefunden4: Boolean;
begin
Gefunden1 := Check('with '+UpperCase(NAME)+' do begin',SourceStrings);
Gefunden2 := Check(BrowserName+'.OnBuildRow:=',SourceStrings);
Gefunden3 := Check(BrowserName+'.BrowserHeader:=',SourceStrings);
Gefunden4 := Check(HeaderName+'.OnSized:= '+HeaderName+'Sized;',SourceStrings);
FormName:= GetFormName(SourceStrings);
S := 0;
{Formcreate-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('.FORMCREATE',SStr) > 0) or (S >= SourceStrings.Count);
{Formcreate Begin wird gesucht}
Dec(S);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('BEGIN',SStr) > 0) or (S >= SourceStrings.Count);
if not Gefunden1 then
begin
if Sprache = 1 then SErrorwindow('KeyProc will be added to FORMCREATE','')
else SErrorwindow('KeyProc wird in','Formcreate eingetragen');
SourceStrings.Insert(S,' with '+Name+' do begin');
Inc(S);
SourceStrings.Insert(S,' Key_Proc := '+Recordname+'KEYPROC;');
Inc(S);
SourceStrings.Insert(S,' Recsize:= Sizeof('+FRecordName+');');
Inc(S);
if FIID.Count > 0 then begin
R := 0;
Repeat
IIDStr := FIID[R];
inc(R);
SourceStrings.Insert(S,' '+IIDStr);
Inc(S);
Until R >= FIID.Count;
end;
SourceStrings.Insert(S,' Active:= True;');
Inc(S);
SourceStrings.Insert(S,' end;');
Inc(S);
end;
if not Gefunden2 then begin
if BrowserName <> '' then begin
if Sprache = 1 then SErrorwindow('OnBuildRow and ConnectLowBrowser',
'will be added to FORMCREATE')
else SErrorwindow('OnbuildRow und ConnectLowBrowser',
'wird in Formcreate eingetragen');
S := 0;
{Formcreate-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('.FORMCREATE',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,' if '+Name+'.Active then begin');
Inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.OnBuildRow:= '+BrowserName+'BuildRow;');
Inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.ConnectLowBrowser(New(PLowWinBrowser, Init(True, '+Name+'.IFBPTR,');
Inc(S);
SourceStrings.Insert(S,' 1, 50, 1, '+Chr(39)+Chr(39)+', '+Chr(39)+Chr(39)+', '+RecordName+'Daten, False )));');
Inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);');
Inc(S);
SourceStrings.Insert(S,' end;');
Inc(S);
end;
end;
if not Gefunden3 then begin
if (BrowserName <> '') and (HeaderName <> '') then begin
if Sprache = 1 then SErrorwindow('BrowserHeader will be added to FORMCREATE','')
else SErrorwindow('BrowserHeader','wird in Formcreate eingetragen');
S := 0;
{Formcreate-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('.FORMCREATE',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,' '+BrowserName+'.BrowserHeader:= '+HeaderName+';');
Inc(S);
end;
end;
if not Gefunden4 then begin
if HeaderName <> '' then begin
S := 0;
{Formcreate-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('.FORMCREATE',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END;',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,' '+HeaderName+'.OnSized:= '+HeaderName+'Sized;');
Inc(S);
end;
end;
end;
Procedure TIsamTable.FormResize_Fuellen(var SourceStrings: TStringList);
Var
S : Integer;
SrceStr, SStr,
FormName : String;
Gefunden1,Gefunden2 : Boolean;
begin
FormName:= GetFormName(SourceStrings);
S := 0;
Gefunden1:= Check(FormName+'.FormResize(',SourceStrings);
Gefunden2 := Check(BrowserName+'.Height',SourceStrings);
if Gefunden1 = False then begin
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('END.'),SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
if BrowserName <> '' then begin
SourceStrings.Insert(S,'Procedure '+FormName+'.FormResize(Sender: TObject);');
inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,'{}'); {Damit Delphi mir das nicht wieder l÷scht}
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
SourceStrings.Insert(S,'');
Inc(S);
end;
S:= 0;
end;
{FormResize-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase(FormName+'.FORMRESIZE'),SStr) > 0) or (S >= SourceStrings.Count);
{FormResize Begin wird gesucht}
Dec(S);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('BEGIN',SStr) > 0) or (S >= SourceStrings.Count);
if not Gefunden2 then begin
if BrowserName <> '' then begin
if Sprache = 1 then SErrorwindow('Browser.Height and Browser.Width added to FORMRESIZE')
else SErrorwindow('Browser.Height und Browser.With wird in','FormResize eingetragen');
SourceStrings.Insert(S,' '+BrowserName+'.Height := ClientHeight-Header1.Height - 10;');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.Width := ClientWidth - 2;');
inc(S);
end;
end;
end;
Procedure TIsamTable.FormShow_Fuellen(var SourceStrings: TStringList);
{ok}
Var
S : Integer;
SrceStr, SStr,
FormName : String;
Gefunden1,Gefunden2: Boolean;
begin
S := 0;
FormName:= GetFormName(SourceStrings);
Gefunden1 := Check(FormName+'.FormShow(',SourceStrings);
Gefunden2 := Check(BrowserName+'.KeyNumber := 1',SourceStrings);
if Gefunden1 = False then begin
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('END.'),SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
if BrowserName <> '' then begin
SourceStrings.Insert(S,'Procedure '+FormName+'.FormShow(Sender: TObject);');
inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,'{}'); {Damit Delphi mir das nicht wieder l÷scht}
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
SourceStrings.Insert(S,'');
Inc(S);
end;
S:= 0;
end;
{FormShow-Rumpf wird gesucht}
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase(FormName+'.FORMSHOW'),SStr) > 0) or (S >= SourceStrings.Count);
{FormShow Begin wird gesucht}
Dec(S);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('BEGIN',SStr) > 0) or (S >= SourceStrings.Count);
if not Gefunden2 then begin
if BrowserName <> '' then begin
SourceStrings.Insert(S,' '+Name+'.KeyNo:= '+BrowserName+'.ReadIni;');
inc(S);
if Sprache = 1 then SErrorwindow('Browser.KeyNumber and Section added to FORMSHOW','')
else SErrorwindow('Browser.KeyNumber und Section wird in','FormShow eingetragen');
SourceStrings.Insert(S,' '+BrowserName+'.ClearIncss;');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.KeyNumber := 1;');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.KeySection := 0;');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.AllowIncSS := True;');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);');
inc(S);
end;
end;
end;
Procedure TIsamTable.HeaderCreate_Einfuegen(var SourceStrings: TStringList);
{ok}
var SrceStr,SStr: String;
Gefunden : Boolean;
i : Byte;
S : Integer;
FormName : String;
begin
if (HeaderName <> '') and (BrowserName <> '') then begin
if Check('Procedure '+HeaderName+'Sized(Sender',SourceStrings) then
begin
if Sprache = 1 then SErrorwindow('Procedure Header.Sized already exists','')
else SErrorwindow('Procedure Header.Sized()','existiert bereits.');
exit;
end;
FormName:= GetFormName(SourceStrings);
S:= 0;
Gefunden:= False;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if Pos(UpperCase('Procedure'+HeaderName+'Sized'),SStr) > 0 then Gefunden:= True;
Inc(S);
Until (Pos('PRIVATE',SStr) > 0) or (S >= SourceStrings.Count);
if Gefunden = False then
begin
Dec(S);
SourceStrings.Insert(S,' Procedure '+HeaderName+'Sized(Sender: TObject; ASection, AWidth: Integer);');
Inc(S);
if Sprache = 1 then SErrorwindow('Procedure Header.Sized added','')
else SErrorwindow('Procedure Header.Sized()','wird eingetragen.');
end;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('{$R*.DFM',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('Procedure'+FormName+'.'+HeaderName+'Sized(Sender'),SStr) > 0)
or (S >= SourceStrings.Count);
if Pos(UpperCase('Procedure'+FormName+'.'+HeaderName+'Sized(Sender'),SStr) = 0 then
begin
S:= 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('END.'),SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,'Procedure '+FormName+'.'+HeaderName+
'Sized(Sender: TObject; ASection, AWidth: Integer);');
Inc(S);
SourceStrings.Insert(S,'begin');
inc(S);
SourceStrings.Insert(S,' {'+BrowserName+'.ResizeHeader;}');
inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);');
inc(S);
SourceStrings.Insert(S,'end;');
inc(S);
SourceStrings.Insert(S,'');
inc(S);
if Sprache = 1 then then sErrorwindow('Procedure Header.Sized added','')
else SErrorwindow('Procedure Header.Sized() ','wird eingetragen.');
end;
end;
end;
Procedure TIsamTable.Browser_BuildRow_Einfuegen(var SourceStrings: TStringList);
{ok}
var SrceStr,SStr: String;
Gefunden : Boolean;
i : Byte;
S : Integer;
FormName : String;
begin
if BrowserName <> '' then begin
if Check('Function '+BrowserName+'BuildRow(',SourceStrings) then
begin
if Sprache = 1 then then SErrorwindow(BrowserName+'Buildrow already exists','')
else SErrorwindow(BrowserName+'BuildRow()','existiert bereits.');
Exit;
end;
FormName:= GetFormName(SourceStrings);
S:= 0;
Gefunden:= False;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
if Pos(UpperCase('Function'+FormName+'.'+
BrowserName+'BuildRow('),SStr) > 0 then Gefunden:= True;
Inc(S);
Until (Pos('PRIVATE',SStr) > 0) or (S >= SourceStrings.Count);
if Gefunden = False then
begin
Dec(S);
SourceStrings.Insert(S,' Function '+BrowserName+'BuildRow(Sender: TObject; var RR: RowRec): Integer;');
Inc(S);
if Sprache = 1 then then SErrorwindow('Function Buildrow will be added','')
else SErrorwindow('Function BuildRow','wird eingetragen.');
end;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('{$R*.DFM',SStr) > 0) or (S >= SourceStrings.Count);
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('FUNCTION'+UpperCase(FormName)+'.'+UpperCase(BrowserName)+'BUILDROW'),SStr) > 0)
or (S >= SourceStrings.Count);
if Pos(UpperCase('FUNCTION'+UpperCase(FormName)+'.'+
UpperCase(BrowserName)+'BUILDROW'),SStr) = 0 then
begin
S:= 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos(UpperCase('END.'),SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,'Function '+FormName+'.'+BrowserName+'BuildRow(Sender: TObject; var RR: RowRec): Integer;');
Inc(S);
SourceStrings.Insert(S,'begin');
inc(S);
SourceStrings.Insert(S,' Result := NoError;');
inc(S);
SourceStrings.Insert(S,' Satzlesen('+Name+'.IfbPtr,RR.Ref,'+RecordName
+'Daten,'+RecordName+'Dup);');
inc(s);
SourceStrings.Insert(S,' with '+RecordName+'Daten do begin');
inc(S);
SourceStrings.Insert(S,' if RR.Status <> NoError then begin');
inc(S);
SourceStrings.Insert(S,' RR.Row := F('+Chr(39)+'**** '+Chr(39)+' + RR.IKS, MaxCols);');
inc(S);
SourceStrings.Insert(S,' end else begin');
inc(S);
SourceStrings.Insert(S,' RR.Row:= '+BrowserName+
'.GetRow('+RECORDName+'GetFeldProc,'+RecordName+'Data);');
inc(S);
SourceStrings.Insert(S,' end;');
inc(S);
SourceStrings.Insert(S,' end;');
inc(S);
SourceStrings.Insert(S,'end;');
inc(S);
if Sprache = 1 then then SErrorwindow('Function Buildrow added','')
else SErrorwindow('Function BuildRow ','wird eingetragen.');
end;
end;
end;
Procedure TIsamTable.Browser_Edit_Einfuegen(var SourceStrings: TStringList);
var SrceStr,SStr: String;
Gef1,Gef2 : Boolean;
i : Byte;
S : Integer;
FormName : String;
begin
if BrowserName <> '' then begin
Gef1:= Check('Procedure '+BrowserName+'DblClick(',SourceStrings);
Gef2:= Check('Procedure '+FormName+'.'+BrowserName+'DblClick(',SourceStrings);
FormName:= GetFormName(SourceStrings);
if Gef1 = False then begin
S:= 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('PRIVATE',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,' Procedure '+BrowserName+'DblClick(Sender: TObject);');
Inc(S);
end;
if Gef2 = False then begin
S:= 0;
Repeat
SrceStr:= SourceStrings[S];
SStr:= Uppercase(SrceStr);
Strip(SStr);
Inc(S);
Until (Pos('END.',SStr) > 0) or (S >= SourceStrings.Count);
Dec(S);
SourceStrings.Insert(S,'procedure '+FormName+'.'+BrowserName+'DblClick(Sender: TObject);');
Inc(S);
SourceStrings.Insert(S,'begin');
Inc(S);
SourceStrings.Insert(S,' '+EditFormIdent+':= T'+EditFormIdent+'.Create(Self);');
Inc(S);
SourceStrings.Insert(S,' Try');
Inc(S);
SourceStrings.Insert(S,' '+Name+'.Ref:= '+BrowserName+'.GetCurrentDatRef;');
Inc(S);
SourceStrings.Insert(S,' '+EditFormIdent+'.'+EditFormIdent+'Table:= IsamTable1;');
Inc(S);
SourceStrings.Insert(S,' '+EditFormIdent+'.SetData;');
Inc(S);
SourceStrings.Insert(S,' '+Name+'.FindKey('+RecordName+'Data,'+RecordName+'Dup,'+Name+'.Key);');
Inc(S);
SourceStrings.Insert(S,' '+EditFormIdent+'.ShowModal;');
Inc(S);
SourceStrings.Insert(S,' Finally');
Inc(S);
SourceStrings.Insert(S,' Application.OnHint:= NIL;');
Inc(S);
SourceStrings.Insert(S,' '+EditFormIdent+'.Free;');
Inc(S);
SourceStrings.Insert(S,' '+BrowserName+'.SetAndUpdateBrowserScreen('+Chr(39)+Chr(39)+', 0);');
Inc(S);
SourceStrings.Insert(S,' end;');
Inc(S);
SourceStrings.Insert(S,'end;');
Inc(S);
end;
end;
end;
Procedure TIsamTable.SetSourceCreate(Const Value: Boolean);
Var SourceStrings : TStringlist;
Formname : String;
R,S : Integer;
begin
if FSourceCreate <> Value then
begin
FSourceCreate := False;
if FrecordName = '' then begin
if Sprache = 1 then then Errorwindow('No Record-Name assigned','')
else Errorwindow('Kein Recordname angegeben!','');
exit;
end;
{$ifndef Test}
if not exist(FUnitName) then
if not ToolServices.SaveProject then
begin
if Sprache = 1 then Errorwindow('Project could not be saved','')
else ErrorWindow('Project konnte nicht','gespeichert werden');
exit;
end;
SourceStrings:= TStringList.Create;
Toolservices.SaveFile(FUnitName);
SourceStrings.LoadFromFile(FUnitName);
{$Else}
SourceStrings:= TStringList.Create;
FUnitName := 'C:\Filer\t2.Pas';
SourceStrings.LoadFromFile(FunitName);
{$Endif}
if SourceStrings.Count > 0 then
begin
FormName:= GetFormName(SourceStrings);
if Sprache = 1 then SErrorwindow('add USES','')
else Serrorwindow('Uses einfⁿgen','');
Uses_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add RECORD','')
else Serrorwindow('Record einfⁿgen','');
Record_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add DATA','')
else Serrorwindow('Data einfⁿgen','');
Data_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add GETFELDPROC','')
else Serrorwindow('Getfeldproc einfⁿgen','');
GetFeldProc_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add KEYPROC','')
else Serrorwindow('Keyproc einfⁿgen','');
Key_Proc_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add KEY-declaration','')
else Serrorwindow('KeyDeklaration einfⁿgen','');
Key_Deklaration_Einfuegen(SourceStrings);
if Sprache = 1 then then SErrorwindow('add FORMCREATE','')
else Serrorwindow('FormCreate einfⁿgen','');
FormCreate_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('fill FORMCREATE','')
else Serrorwindow('FormCreate Fⁿllen einfⁿgen','');
FormCreate_Fuellen(SourceStrings);
if Sprache = 1 then SErrorwindow('fill FORMSHOW','')
else Serrorwindow('FormShow Fⁿllen einfⁿgen','');
FormShow_Fuellen(SourceStrings);
if Sprache = 1 then SErrorwindow('fill FORMRESIZE','')
else Serrorwindow('FormResize Fⁿllen einfⁿgen','');
FormResize_Fuellen(SourceStrings);
if Sprache = 1 then SErrorwindow('add HEADERCREATE','')
else Serrorwindow('HeaderCreate einfⁿgen','');
HeaderCreate_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('add BUILDROW','')
else Serrorwindow('BuildRow einfⁿgen','');
Browser_BuildRow_Einfuegen(SourceStrings);
if Sprache = 1 then SErrorwindow('delete brackets','')
else SErrorwindow('Klammern L÷schen','');
Klammern_Loeschen(SourceStrings);
if EditFormIdent <> '' then begin
if Sprache = 1 then then SErrorwindow('BROWSER-Edit','')
else SErrorwindow('Browser-Editoraufruf','');
Browser_Edit_Einfuegen(SourceStrings);
end;
{$ifdef Test}
FUnitName := 'C:\Filer\t2.Pas';
{$EndIf}
SourceStrings.SaveToFile(FUnitName);
{$IfNDef Test}
MySave;
{$Endif}
end;
SourceStrings.Free;
end;
end;
{Procedure TIsamTable.SetEditorCreate(const Value: Boolean);
begin
FEditorCreate:= False;
if csDesigning in ComponentState then begin
if IsamRecord.Count > 0 then begin
Try
EditorExperte:= TEditorExperte.Create(Application);
EditorExperte.FTable.IsamRecord.Assign(IsamRecord);
EditorExperte.FTable.IsamKeyProc.Assign(IsamKeyProc);
EditorExperte.FTable.RecordName:= RecordName;
if EditorExperte.ShowModal = mrOk then EditFormIdent:= EditorExperte.FormIdent;
Finally
EditorExperte.Free;
End;
end
else Errorwindow('Bitte zunΣchst Record definieren','');
end;
end;}
{$ENDIF}
begin
FHandle:= InitToolDll;
end.